BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Tele/Pete Johnson/ff 1.5 source.cpt/ff.p

Text File | 1991-08-05 | 29.8 KB | 1,036 lines | [TEXT/PJMM]

program ff;

{    Forwards local and net private mail to net addresses entered in    }
{    a text file called 'ff List'                                }
{    Format for text file is as follows:                        }
{    FirstName <space> LastName <tab> NodeID <return>                }
{    Lines beginning with open parens are ignored and can be used as    }
{    comments.                                                }
{    Can handle a maximum of 200 names and node numbers.            }
{    STRs:                                                }
{        499 -- private message mark (^P)                        }
{        500 -- next launch                                    }
{        502 -- defaults xx                                    }
{                                                        }
{    Written by Pete Johnson beginning Feb. 24, 1990.                }
{    3/10/90    V 1.3    Reads from old to new                    }
{    3/16/90    V 1.4    Fixes path problem with EMS & Sendfiles        }
{    3/23/90    V 1.5    Added check to ignore deleted message        }
{    3/23/90    V 1.51    Fixed check for deleted message            }
{    3/30/90    V 1.0    Name changed to ff, added ID sig to messages    }
{    3/31/90    V 1.01    Writes EMS files sent to AreaTrix Workfile    }
{    4/1/90    V 1.02    Adds extra CR before signature            }
{    4/21/90    V 1.1    Creates proper sendmailxxx/yyy.bbs packets    }
{    5/5/90    V 1.2    Tags local private messages with PRIVMARK at    }
{                    end of From (preferred) or Subject line        }
{    5/12/90    V 1.3    Handles point addressing correctly            }
{    6/16/90    V 1.4    Uses "processed" flag instead of message no.    }
{    6/23/90    V 1.41    Fixes mangled Sendmail7500/.bbs names        }
{    12/8/90    V 1.42    Works correctly with passwords            }
{    12/28/90    V 1.43    Sigh, fixes bug with passwords            }
{    1/19/91    V 1.44    Adds Delete Message toggle, works on garbage    }
{                    in node number bug                        }
{    1/21/91    V 1.45    Fixes garbage in node number bug -- this was    }
{                    caused by not filtering out point numbers    }
{                    from incoming messages. Also eliminated        }
{                    double ff tags                            }
{    2/5/91    V 1.47    Handles 'McName' correctly.                }
{    5/29/91    V 1.48    Added SystemTasks & SIZE resource.            }
{    7/14/91    V 1.49    Refined routine to find place in messages.    }
{    7/18/91    V 1.5    Fixed problem with origin node ID & added    }
{                    color icons.                            }

uses
    HelloTabby;

const
    VERSION = '1.5';
    TabbyFlag = 64;
    TAB = chr(9);
    ENDLINE = chr(13);
    SPACE = chr(32);
    PAREN = '(';
    IGNORE = 0;
    LOCALPRIV = 1;
    NETPRIV = 3;
    NULL = chr(0);
    CTLA = chr(1);
    ADDRESSFILE = 'ff List';
    MAXNAMES = 200;
    DEBUG = false;    {if true, writes extra info -- search for 'debug' to find}

type
    Person = record
            Name: string[32];
            Location: string[16];
        end;        {    Person record    }
    PersonPtr = ^Person;
    PersonHdl = ^PersonPtr;
    Address = array[1..MAXNAMES] of PersonHdl;

var
    TheAddress: Address;
    LastEntry, CurrentResFile: integer;
    NetPrivSect: byte;
    MESSAGESPath, MsgPath, TempString, PointNet, GenericPath, LocalNodeID, Defaults: str255;
    TempFrom, TempSubj, PrivMark: str255;
    LowMsg, HiMsg, MSGTXTLength: string;
    LowMsgInt, HiMsgInt, MSGTXTLengthInt: longint;
    OrigNode, OrigNet, DestNode, DestNet: longint;
    MsgCategory: array[1..255] of integer;
    DialogPointer: DialogPtr;
    DoLocPriv, DoNetPriv: boolean;

{-----------------------------------------------------------------    }

procedure DeCap (var TheName: str255);

    var
        NameCount: integer;

    procedure HandleMcName (var McN: str255);    {Adjusts caps in names such as McNamara}

        var
            i: integer;

        begin
            if (length(McN) > 2) then
                for i := 3 to length(McN) do
                    if ((McN[i - 1] = 'c') & (McN[i - 2] = 'M') & (McN[i] in ['a'..'z'])) & ((i = 3) | (McN[i - 3] = ' ')) then
                        McN[i] := chr(ord(McN[i]) - 32);
        end;

    begin
        UprString(TheName, false);
        for NameCount := 2 to length(TheName) do        {    Convert name to caps & lower case    }
            if (TheName[NameCount]) in ['A'..'Z'] then
                if (TheName[NameCount - 1] in ['A'..'Z', 'a'..'z']) then
                    TheName[NameCount] := chr(ord(TheName[NameCount]) + 32);

        HandleMcName(TheName)
    end;

{-----------------------------------------------------------------    }

function AtEOF (fRefNum: Integer): Boolean;
    var
        currPos, eofPos: LongInt;

    begin
        Err := GetFPos(fRefNum, currPos);
        Err := GetEOF(fRefNum, eofPos);
        AtEOF := currPos = eofPos
    end;

{ ------------------------------------------------------ }

function Wr (FileRefNum: integer; TheMessage: string): OSErr;

{    Writes string (without length byte) to text file, returns error code    }

    var
        TheLength: longint;

    begin
        TheLength := length(TheMessage);
        Wr := FSWrite(FileRefNum, TheLength, Pointer(ord(@TheMessage) + 1));
    end;

{-----------------------------------------------------------------    }

function WrLn (FileRefNum: integer; TheMessage: string): OSErr;

{    Writes string (without length byte) to text file, returns error code    }

    begin
        TheMessage := concat(TheMessage, ENDLINE);
        WrLn := Wr(FileRefNum, TheMessage);
    end;

{-----------------------------------------------------------------    }

procedure FrameDItem (dLog: DialogPtr; iNum: integer);

    var
        iBox: Rect;
        iType: integer;
        iHandle: Handle;
        oldPenState: PenState;

    begin
        GetPenState(oldPenState);
        GetDItem(dLog, iNum, iType, iHandle, iBox);
        InsetRect(iBox, -4, -4);
        PenSize(3, 3);
        FrameRoundRect(iBox, 16, 16);
        SetPenState(oldPenState)
    end;

{-----------------------------------------------------------------    }

procedure MakeTextFile (FileName: STR255);

{    Sets up QUED-compatible text  file                    }

    var
        fndrInfo: FInfo;

    begin
        Err := GetFInfo(FileName, vRefNum, fndrInfo);
        if Err = noErr then
            begin
                fndrInfo.fdType := 'TEXT';
                fndrInfo.fdCreator := 'QED1';
                Err := SetFInfo(FileName, vRefNum, fndrInfo);
            end
        else
            Err := Create(FileName, vRefNum, 'QED1', 'TEXT');
    end;

{-----------------------------------------------------------------    }

function ButtonSelected (whichDialog: DialogPtr; whichItem: integer): boolean;

    var
        whichType: integer;
        whichHandle: handle;
        whichRect, displayRect: rect;
        mouseLoc: point;
        DelayTime: longint;
        nowInverted: boolean;

    begin
        getDItem(whichDialog, whichItem, whichType, whichHandle, whichRect);
        displayRect := whichRect;
        InsetRect(displayRect, 1, 1);
        InvertRect(displayRect);
        nowInverted := true;
        if StillDown then
            repeat
                GetMouse(mouseLoc);
                if PtInRect(mouseLoc, whichRect) then
                    begin
                        if not nowInverted then
                            begin
                                InvertRect(displayRect);
                                nowInverted := true
                            end
                    end
                else
                    begin
                        if nowInverted then
                            begin
                                InvertRect(displayRect);
                                nowInverted := false
                            end
                    end
            until not StillDown;
        if nowInverted then
            begin
                Delay(4, DelayTime);
                InvertRect(displayRect);
            end;
        ButtonSelected := nowInverted
    end;

{-----------------------------------------------------------------    }

procedure ReadConfig;

{    Reads Config file and returns Path:MESSAGES                    }

    var
        AString: string;
        ConfigRefNum: integer;
        CharsToSend: longint;

    begin
        MESSAGESPath := '';
        Err := FSOpen(concat(gDefaultpath, 'Config'), VRefNum, ConfigRefNum);
        if (Err = NoErr) then
            begin
                CharsToSend := 80;
                Err := SetFPos(ConfigRefNum, fsFromStart, 139);
                Err := FSRead(ConfigRefNum, CharsToSend, @AString);
                if length(AString) > 0 then
                    MESSAGESPath := AString;
                MESSAGESPath := concat(MESSAGESPath, ':MESSAGES');
            end;    {    Error on open Config    }
        Err := FSClose(ConfigRefNum);
    end;

{-----------------------------------------------------------------    }

procedure ReadMESSAGES;

{ Reads the MESSAGES file                                    }

    var
        MSGRefNum, MSCount, Counter: integer;
        CharsToSend: longint;
        MsgByte: byte;

    begin
        Counter := 0;
        NetPrivSect := 50;
        Err := FSOpen(MESSAGESPath, VRefNum, MSGRefNum);

        CharsToSend := 50;
        Err := FSRead(MSGRefNum, CharsToSend, @MsgPath);
        if MsgPath <> '' then
            MsgPath := concat(MsgPath, ':');

        CharsToSend := 4;
        Err := SetFPos(MSGRefNum, fsFromStart, 50);
        Err := FSRead(MSGRefNum, CharsToSend, @LowMsg);
        Err := FSRead(MSGRefNum, CharsToSend, @HiMsg);
        Err := FSRead(MSGRefNum, CharsToSend, @MSGTXTLength);

        StringToNum(LowMsg, LowMsgInt);
        StringToNum(HiMsg, HiMsgInt);
        StringToNum(MSGTXTLength, MSGTXTLengthInt);

        for MSCount := 1 to 255 do
            begin
                Err := SetFPos(MSGRefNum, fsFromStart, (97 + (MSCount - 1) * 36));
                MsgByte := 0;
                CharsToSend := 1;
                Err := FSRead(MSGRefNum, CharsToSend, @MsgByte);

                MsgByte := MsgByte div 256;

                case MsgByte of

                    NETPRIV:
                        begin
                            MsgCategory[MSCount] := NETPRIV;
                            NetPrivSect := MSCount
                        end;

                    LOCALPRIV:
                        MsgCategory[MSCount] := LOCALPRIV;

                    otherwise
                        MsgCategory[MSCount] := IGNORE;

                end;    {    case statement    }

            end;        {    for MSCount := 1 to 255 do    }

        Err := FSClose(MSGRefNum);
    end;

{-----------------------------------------------------------------    }

procedure CleanString (var TheString: str255);

    begin
        while (TheString[1] in [SPACE, TAB]) & (length(TheString) > 1) do
            TheString := copy(TheString, 2, 255);
        while (TheString[length(TheString)] in [SPACE, TAB]) & (length(TheString) > 1) do
            TheString := copy(TheString, 1, length(TheString) - 1)
    end;

{-----------------------------------------------------------------    }

procedure ReadSettings;

    var
        AddressRef, Counter, TabMark, StrCount: integer;
        Entry, TempStr, TempStr2: str255;

    begin
        Counter := 1;
        Err := FSOpen(AddressFile, vRefNum, AddressRef);
        if Err = NoErr then
            Err := SetFPos(AddressRef, fsFromStart, 0);
        if Err = NoErr then
            while (not AtEOF(AddressRef)) & (Counter <= MAXNAMES) do
                begin
                    Err := ReadALine(AddressRef, Entry);
                    if Err = NoErr then
                        begin
                            TabMark := pos(TAB, Entry);
                            if (TabMark > 0) & (pos(PAREN, Entry) <> 1) then
                                begin
                                    TheAddress[Counter] := PersonHdl(NewHandle(SizeOf(Person)));
                                    TempStr := copy(Entry, 1, TabMark - 1);
                                    CleanString(TempStr);
                                    TheAddress[Counter]^^.Name := TempStr;
                                    TempStr := copy(Entry, TabMark + 1, 20);
                                    StrCount := 1;
                                    TempStr2 := '';
                                    while ((TempStr[StrCount] in ['0'..'9']) | (TempStr[StrCount] = '/') | (TempStr[StrCount] = '.') | (TempStr[StrCount] = ':')) & (StrCount <= length(TempStr)) do
                                        begin
                                            TempStr2 := concat(TempStr2, TempStr[StrCount]);
                                            StrCount := succ(StrCount);
                                        end;
                                    TheAddress[Counter]^^.Location := TempStr2;
                                    Counter := succ(Counter);
                                end
                        end
                end;
        LastEntry := Counter - 1;
        Err := FSClose(AddressRef)
    end;

{-----------------------------------------------------------------    }

procedure ProcessHeaders;

    const
        Active = 1;
        Deleted = 1;
        Undeleted = 0;

    type
        DateTimeRecord = packed array[1..6] of char;
        Header = record
                Status: packed array[1..2] of Byte;    {    use Status[1]    }
                MsgNo: longint;
                Section: packed array[1..2] of Byte;    {    use Section[1]    }
                TimeRcvd: DateTimeRecord;
                MsgFrom: string[31];
                MsgTo: string[31];
                MsgSubject: string[41];
                Dest: string[67];
                BeginText: longint;
                LengthText: longint;
                ReplyTo: longint;
                TimeSent: DateTimeRecord
            end;        {    Header record    }
        MText = packed array[1..32000] of char;
        MTextPtr = ^MText;
        MTextHandle = ^MTextPtr;
        PacketHeader = packed array[0..57] of byte;

    var
        MHdrRef, Counter, UserCount, SendRef, MSGTXTRef, CompressRef, Count, PWRef: integer;
        NextCount, TheStatus: integer;
        TheHeader: Header;
        HeaderSize, CharsToSend, logicalEOF, TempLong, MSGTXTPos: longint;
        TempTo, TempNode, TempFileName, OneLine, NodeString, TempTime, Password: str255;
        TheTextHandle: MTextHandle;

{ -----------------------------------------------------}

    procedure FindMHPosition;

        var
            HiBound, LoBound, HeaderEnd, Position: longint;

{ Procedure finds correct position in MSGHDR file                    }

        begin
            Err := GetEOF(MHdrRef, HeaderEnd);
            HiBound := (HeaderEnd div HeaderSize) - 1;    {    ...mark start of last record        }
            LoBound := 0;
            repeat
                Position := (LoBound + HiBound) div 2;
                if Err = NoErr then
                    Err := SetFPos(MHdrRef, fsFromStart, Position * HeaderSize);
                if Err = NoErr then
                    Err := FSRead(MHdrRef, HeaderSize, @TheHeader);
                if Err = NoErr then
                    if (BitAnd(TabbyFlag, TheHeader.Status[1]) = TabbyFlag) then    {processed for Tabby}
                        LoBound := Position + 1
                    else
                        HiBound := Position - 1
                else {file errors}
                    Position := 0
            until (LoBound > HiBound) | (Err <> NoErr);
    {back up a bit just to be sure}
            while (BitAnd(TabbyFlag, TheHeader.Status[1]) <> TabbyFlag) & (Err = NoErr) & (Position > 0) do
                begin
                    Position := pred(Position);
                    Err := SetFPos(MHdrRef, fsFromStart, Position * HeaderSize);
                    Err := FSRead(MHdrRef, HeaderSize, @TheHeader);
                end;
        end;        {    procedure FindMHPosition    }

{ ------------------------------------------------------ }

    function MakeTime (Index: integer; Separator: char; WhenRcvdString: DateTimeRecord): string;

{ Function changes three chars of DateTimeRecord to formatted time or date string    }

        var
            MakeTimeString, LocalTemp: STR255;
            OneChar: char;

        begin
            LocalTemp := '';
            if Separator = ' ' then        {    Need to swap bytes 1&2 of RRH date        }
                begin                    {    record to put into proper Fido order.    }
                    OneChar := WhenRcvdString[1];
                    WhenRcvdString[1] := WhenRcvdString[2];
                    WhenRcvdString[2] := OneChar
                end;
            NumToString(ord(WhenRcvdString[Index + 1]), LocalTemp);
            if length(LocalTemp) = 1 then
                LocalTemp := concat('0', LocalTemp);
            MakeTimeString := concat(LocalTemp, Separator);
            if Separator = ':' then
                begin
                    NumToString(ord(WhenRcvdString[Index + 2]), LocalTemp);
                    if length(LocalTemp) = 1 then
                        LocalTemp := concat('0', LocalTemp);
                end
            else
                case ord(WhenRcvdString[Index + 2]) of

                    1:
                        LocalTemp := 'Jan';

                    2:
                        LocalTemp := 'Feb';

                    3:
                        LocalTemp := 'Mar';

                    4:
                        LocalTemp := 'Apr';

                    5:
                        LocalTemp := 'May';

                    6:
                        LocalTemp := 'Jun';

                    7:
                        LocalTemp := 'Jul';

                    8:
                        LocalTemp := 'Aug';

                    9:
                        LocalTemp := 'Sep';

                    10:
                        LocalTemp := 'Oct';

                    11:
                        LocalTemp := 'Nov';

                    otherwise
                        LocalTemp := 'Dec'

                end;        {    case statement    }
            MakeTimeString := concat(MakeTimeString, LocalTemp, Separator);
            NumToString(ord(WhenRcvdString[Index + 3]), LocalTemp);
            if length(LocalTemp) = 1 then
                LocalTemp := concat('0', LocalTemp);
            MakeTime := concat(MakeTimeString, LocalTemp)
        end;

{-----------------------------------------------------------------    }

    procedure WritePacketHeader (Dest: str255; FileRef: integer);

        var
            PHeader: PacketHeader;
            NowSecs, TheLength: longint;
            Now: DateTimeRec;
            Counter: integer;

        begin
            GetDateTime(NowSecs);
            Secs2Date(NowSecs, Now);

            if pos('/', Dest) > 0 then
                begin
                    StringToNum(copy(Dest, pos('/', Dest) + 1, 255), DestNode);
                    StringToNum(copy(Dest, 1, pos('/', Dest) - 1), DestNet);

                    PHeader[0] := OrigNode mod 256;
                    PHeader[1] := OrigNode div 256;
                    PHeader[2] := DestNode mod 256;
                    PHeader[3] := DestNode div 256;
                    PHeader[4] := Now.Year mod 256;
                    PHeader[5] := Now.Year div 256;
                    PHeader[6] := Now.Month mod 256;
                    PHeader[7] := 0;
                    PHeader[8] := Now.Day mod 256;
                    PHeader[9] := 0;
                    PHeader[10] := Now.Hour mod 256;
                    PHeader[11] := 0;
                    PHeader[12] := Now.Minute mod 256;
                    PHeader[13] := 0;
                    PHeader[14] := Now.Second mod 256;
                    PHeader[15] := 0;
                    PHeader[16] := 0;            {    Baud rate    }
                    PHeader[17] := 0;            {    Baud rate    }
                    PHeader[18] := 2;            {    Version    }
                    PHeader[19] := 0;            {    Version    }
                    PHeader[20] := OrigNet mod 256;
                    PHeader[21] := OrigNet div 256;
                    PHeader[22] := DestNet mod 256;
                    PHeader[23] := DestNet div 256;
                    PHeader[24] := 8;            {    Tabby product code    }
                    PHeader[25] := 2;            {    Tabby product code    }
                    for Counter := 26 to 56 do
                        PHeader[Counter] := 0;        {    Filler            }
                    if (length(Password) > 0) then
                        for Counter := 26 to (25 + length(Password)) do
                            PHeader[Counter] := ord(Password[Counter - 25]) mod 256;
                    PHeader[34] := 1;            {    Tabby junk???        }
                    PHeader[36] := 1;            {    Tabby junk???        }
                    PHeader[57] := 25;            {    Tabby junk???        }
                    TheLength := 58;

                    Err := FSWrite(FileRef, TheLength, @PHeader);
                end        {    if pos('/', Dest) > 0    }
        end;

{-----------------------------------------------------------------    }

    procedure WriteMessageTop (MDest, MOrig, MDate, MTo, MFrom, MSub: str255; FileRef: integer);

        var
            TheTop: str255;
            MDestNode, MDestNet, MOrigNode, MOrigNet, TheLength: longint;

        begin
            if (pos('.', MDest) > 1) then
                MDest := copy(MDest, 1, pos('.', MDest) - 1);
            if (pos('.', MOrig) > 1) then
                MOrig := copy(MOrig, 1, pos('.', MOrig) - 1);
            if pos('/', MDest) > 1 then
                begin
                    TheTop := '';
                    StringToNum(copy(MDest, pos('/', MDest) + 1, 255), MDestNode);
                    StringToNum(copy(MDest, 1, pos('/', MDest) - 1), MDestNet);
                    StringToNum(copy(MOrig, pos('/', MOrig) + 1, 255), MOrigNode);
                    StringToNum(copy(MOrig, 1, pos('/', MOrig) - 1), MOrigNet);
                    TheTop[1] := chr(2);                {    Msg Type    }
                    TheTop[2] := chr(0);                {    Msg Type    }
                    TheTop[3] := chr(MOrigNode mod 256);    {    Origin    }
                    TheTop[4] := chr(MOrigNode div 256);    {    Origin    }
                    TheTop[5] := chr(MDestNode mod 256);    {    Destin    }
                    TheTop[6] := chr(MDestNode div 256);    {    Destin    }
                    TheTop[7] := chr(MOrigNet mod 256);    {    Origin    }
                    TheTop[8] := chr(MOrigNet div 256);    {    Origin    }
                    TheTop[9] := chr(MDestNet mod 256);    {    Destin    }
                    TheTop[10] := chr(MDestNet div 256);    {    Destin    }
                    TheTop[11] := chr(0);                {    Attribute    }
                    TheTop[12] := chr(0);                {    Attribute    }
                    TheTop[13] := chr(0);                {    Cost        }
                    TheTop[14] := chr(0);                {    Cost        }
                    TheTop[0] := chr(14);

                    TheTop := concat(TheTop, MDate);

                    if length(MTo) > 35 then
                        MTo := copy(MTo, 1, 35);
                    TheTop := concat(TheTop, MTo, chr(0));

                    if length(MFrom) > 35 then
                        MFrom := copy(MFrom, 1, 35);
                    TheTop := concat(TheTop, MFrom, chr(0));

                    if length(MSub) > 71 then
                        MSub := copy(MSub, 1, 71);
                    TheTop := concat(TheTop, MSub, chr(0));

                    TheLength := length(TheTop);

                    Err := FSWrite(FileRef, TheLength, Pointer(ord(@TheTop) + 1));    { Skip length byte }
                end
        end;

{-----------------------------------------------------------------    }

        var
            FromPoint, PointID: longint;

    begin
        HeaderSize := SizeOf(Header);
        TheHeader.MsgNo := maxlongint;
        CharsToSend := HeaderSize;

        Err := FSOpen(concat(MsgPath, 'MSGHDR'), VRefNum, MHdrRef);
        FindMHPosition;

        while (not AtEOF(MHdrRef)) do
            begin
                if MultiFinder then
                    IgnoreBool := WaitNextEvent(EveryEvent, TabbyEventRec, sleep, nil);
                Err := FSRead(MHdrRef, CharsToSend, @TheHeader);

                TheStatus := MsgCategory[TheHeader.Section[1]];
                if (BitAnd(TabbyFlag, TheHeader.Status[1]) <> TabbyFlag) then
                    if BitAnd(TheHeader.Status[1], Active) = Undeleted then            {    is it active?    }
                        if ((TheStatus = LOCALPRIV) & DoLocPriv) | ((TheStatus = NETPRIV) & DoNetPriv) then
                            begin
                                TempTo := TheHeader.MsgTo;
                                CleanString(TempTo);
                                for UserCount := 1 to LastEntry do
                                    if EqualString(TheAddress[UserCount]^^.Name, TempTo, false, false) then
                                        begin
                                            FromPoint := 0;
                                            PointID := 0;
                                            TempSubj := TheHeader.MsgSubject;
                                            TempFrom := TheHeader.MsgFrom;
                                            DeCap(TempFrom);
                                            DeCap(TempTo);
                                            if (TheStatus = LOCALPRIV) then
                                                begin
                                                    if length(TempFrom) <= (30 - length(PrivMark)) then        {MsgFrom can be 30 chars}
                                                        TempFrom := concat(TempFrom, PrivMark)
                                                    else                            {MsgSubject can be 40 chars}
                                                        TempSubj := concat(copy(TempSubj, 1, (40 - length(PrivMark))), PrivMark);
                                                    TheHeader.Dest := LocalNodeID        { i.e. '102/823' }
                                                end;
                                            if (TheHeader.Dest = '') then
                                                TheHeader.Dest := LocalNodeID;        { i.e. '102/823' }

                                            Password := '';
                                            Err := FSOpen(concat(gDefaultpath, 'Tabby:Password'), VRefNum, PWRef);
                                            if Err = NoErr then
                                                while not AtEOF(PWRef) do
                                                    begin
                                                        Err := ReadALine(PWRef, TempString);
                                                        if (pos(LocalNodeID, TempString) > 0) & (pos(Tab, TempString) > 0) then
                                                            begin
                                                                Password := copy(TempString, pos(Tab, TempString) + 1, 255);
                                                                CleanString(Password);
                                                                Leave
                                                            end
                                                    end;
                                            Err := FSClose(PWRef);

                                            if pos('.', TheHeader.Dest) > 0 then
                                                begin
                                                    StringToNum(copy(TheHeader.Dest, pos('.', TheHeader.Dest) + 1, 255), FromPoint);
                                                    TheHeader.Dest := copy(TheHeader.Dest, 1, pos('.', TheHeader.Dest) - 1)
                                                end;

                                            TempNode := TheAddress[UserCount]^^.Location;
                                            if pos('.', TempNode) > 0 then
                                                begin
                                                    StringToNum(copy(TempNode, pos('.', TempNode) + 1, 255), PointID);
                                                    TempNode := copy(TempNode, 1, pos('.', TempNode) - 1)
                                                end;
                                            MakeTextFile(concat(GenericPath, 'sendmail', TempNode, '.bbs'));
                                            Err := FSopen(concat(GenericPath, 'sendmail', TempNode, '.bbs'), VRefNum, SendRef);
                                            if Err = NoErr then
                                                Err := GetEOF(SendRef, TempLong);

                                            if (Err = NoErr) & (TempLong < 62) then        { Empty, write new        }
                                                begin
                                                    WritePacketHeader(TempNode, SendRef);
                                                    MakeTextFile(concat(gDefaultpath, 'Tabby:Compress Mail'));    { Since new, set to compress }
                                                    Err := FSOpen(concat(gDefaultpath, 'Tabby:Compress Mail'), VRefNum, CompressRef);
                                                    Err := SetFPos(CompressRef, FSFromLEOF, 0);    { Go to end    }
                                                    Err := WrLn(CompressRef, concat('sendmail', TempNode, '.bbs'));
                                                    Err := FSClose(CompressRef)
                                                end
                                            else if Err = NoErr then                    { Header w/ messages    }
                                                Err := SetFPos(SendRef, FSFromLEOF, -2);    { Overwrite 00 00 bytes    }

                                            TempTime := MakeTime(0, ' ', TheHeader.TimeSent);
                                            TempTime := concat(TempTime, '  ', MakeTime(3, ':', TheHeader.TimeSent), NULL);

{    procedure form is WriteMessageTop(MDest, MOrig, MDate, MTo, MFrom, MSub,FRef    )            }

                                            WriteMessageTop(TempNode, TheHeader.Dest, TempTime, TempTo, TempFrom, TempSubj, SendRef);

                                            if DEBUG then
                                                Err := WrLn(SendRef, concat('Debug info <To> <From> <LocalNodeID> <', TempNode, '> <', TheHeader.Dest, '> <', LocalNodeID, '>', ENDLINE)); {debug}

                                            Err := FSOpen(concat(MsgPath, 'MSGTXT'), VRefNum, MSGTXTRef);
                                            Err := SetFPos(MSGTXTRef, fsFromStart, TheHeader.BeginText);
                                            TheTextHandle := MTextHandle(NewHandle(sizeOf(MText)));
                                            Err := FSRead(MSGTXTRef, TheHeader.LengthText, Ptr(TheTextHandle^));

                                            if (PointID > 0) then
                                                begin
                                                    TempString := concat(CTLA, 'TOPT ', stringof(PointID : 1));
                                                    Err := WrLn(SendRef, TempString)
                                                end;

                                            if (FromPoint > 0) then
                                                begin
                                                    TempString := concat(CTLA, 'FMPT ', stringof(FromPoint : 1));
                                                    Err := WrLn(SendRef, TempString)
                                                end;

{    Message text is in Pascal string form. Need to convert it to ASCII text.    }

                                            for Count := 1 to TheHeader.LengthText do
                                                begin
                                                    NextCount := integer(TheTextHandle^^[Count]);
                                                    if Count > 1 then
                                                        TheTextHandle^^[Count] := ENDLINE;
                                                    Count := Count + NextCount
                                                end;

{    Get rid of first length byte                }

                                            CharsToSend := TheHeader.LengthText - 1;
                                            if (CharsToSend < 1) then
                                                begin
                                                    TheTextHandle^^[1] := chr(9);
                                                    TheTextHandle^^[2] := ENDLINE;
                                                    CharsToSend := 2
                                                end;
                                            for Count := 1 to CharsToSend do
                                                TheTextHandle^^[Count] := TheTextHandle^^[Count + 1];

                                            Err := FSWrite(SendRef, CharsToSend, Ptr(TheTextHandle^));

                                            TempString := '';
                                            for Count := (CharsToSend - 100) to CharsToSend do
                                                TempString := concat(TempString, TheTextHandle^^[Count]);

                                            DisposHandle(Handle(TheTextHandle));

                                            Err := WrLn(SendRef, ENDLINE);
                                            if pos('--- ff', TempString) = 0 then
                                                Err := WrLn(SendRef, concat('--- ff ', VERSION));
                                            Err := Wr(SendRef, NULL);                {    End of message    }
                                            Err := Wr(SendRef, concat(NULL, NULL));        {    End of file    }
                                            Err := FSClose(MSGTXTRef);
                                            Err := FSClose(SendRef);

                                            TheHeader.Status[1] := BitOr(Deleted, TheHeader.Status[1]);    {Set Delete Bit    }
                                            CharsToSend := sizeOf(TheHeader);
                                            Err := SetFPos(MHdrRef, fsFromMark, -CharsToSend);    {    Back up to the start of this record    }
                                            Err := FSWrite(MHdrRef, CharsToSend, @TheHeader);
                                            leave
                                        end        {    if TheAddress[UserCount]^^.Name = TempTo    }
                            end        {    if TheStatus = LOCALPRIV or NETPRIV    }

            end;    {    while (not AtEOF(MHdrRef))    }

        Err := FSClose(MHdrRef)
    end;

{-----------------------------------------------------------------    }

procedure Initialize;

    var
        PointNetID, GenericID, ConfigID: integer;

    begin
        CurrentResFile := CurResFile;
        ParamText(VERSION, '', '', '');
        PrivMark := GetString(499)^^;
        Defaults := GetString(502)^^;
        if length(Defaults) < 2 then
            Defaults := 'YY';
        if Defaults[1] = 'Y' then
            DoLocPriv := true
        else
            DoLocPriv := false;
        if Defaults[2] = 'Y' then
            DoNetPriv := true
        else
            DoNetPriv := false;

        Err := HGetVol(@gVolName, vRefNum, dirID);        { Get volume ref # & dirID for default volume    }
        gDefaultpath := PathNameFromDirID(dirID, vRefNum);    { Get full pathname                            }

        Err := FSOpen(concat(gDefaultpath, 'Tabby:Point Net'), vRefNum, PointNetID);
        if Err = NoErr then
            begin
                Err := ReadALine(PointNetID, PointNet);
                Err := FSClose(PointNetID)
            end
        else
            PointNet := '';
        Err := FSOpen(concat(gDefaultpath, 'Generic'), vRefNum, GenericID);
        if Err = NoErr then
            begin
                Err := ReadALine(GenericID, GenericPath);
                Err := FSClose(GenericID)
            end
        else
            GenericPath := '';

        OrigNode := 0;
        OrigNet := 0;
        Err := FSOpen(concat(gDefaultpath, 'Tabby:Tabby Config'), vRefNum, ConfigID);
        if Err = NoErr then
            begin
                Err := ReadALine(ConfigID, LocalNodeID);
                Err := FSClose(ConfigID);
                if pos(':', LocalNodeID) > 0 then
                    LocalNodeID := copy(LocalNodeID, pos(':', LocalNodeID) + 1, 255);
                if pos('/', LocalNodeID) > 0 then
                    begin
                        StringToNum(copy(LocalNodeID, pos('/', LocalNodeID) + 1, 255), OrigNode);
                        StringToNum(copy(LocalNodeID, 1, pos('/', LocalNodeID) - 1), OrigNet)
                    end
            end
        else
            LocalNodeID := ''
    end;

{-----------------------------------------------------------------    }

procedure ShowMainDialog;


    begin
        DialogPointer := GetNewDialog(500, nil, POINTER(-1));
        DrawDialog(DialogPointer);
        SetPort(DialogPointer);
    end;

{-----------------------------------------------------------------    }

procedure CleanUp;

    var
        Counter: integer;

    begin
        for Counter := 1 to LastEntry do
            DisposHandle(Handle(TheAddress[Counter]));
        DisposDialog(DialogPointer)
    end;

{ ------------------------------------------------------ }

procedure HandleConfig;

    var
        LastHiMsgString: str255;
        theDialog: DialogPtr;
        ItemHit, itemType, whichItem, MsgRefNum: integer;
        itemHandle: Handle;
        dispRect: Rect;
        thisButton: ControlHandle;
        where: point;
        CharsToSend, HiMsgNumber: longint;
        fileReply: SFReply;
        whatToFind: SFTypeList;

    begin
        InitCursor;
        ParamText(concat('v. ', VERSION), '', '', '');
        theDialog := GetNewDialog(501, nil, POINTER(-1));
        SetPort(theDialog);
        FrameDItem(theDialog, Ok);

        NextLaunch := GetString(500)^^;        {    Get next launch string from resource    }
        getDItem(theDialog, 3, itemType, itemHandle, dispRect);
        SetIText(Handle(itemHandle), NextLaunch);

        getDItem(theDialog, 5, itemType, itemHandle, dispRect);
        thisButton := ControlHandle(itemHandle);
        if DoLocPriv then
            SetCtlValue(thisButton, 1)
        else
            SetCtlValue(thisButton, 0);

        getDItem(theDialog, 6, itemType, itemHandle, dispRect);
        thisButton := ControlHandle(itemHandle);
        if DoNetPriv then
            SetCtlValue(thisButton, 1)
        else
            SetCtlValue(thisButton, 0);

        if StillDown then
            repeat
            until not Button;
        repeat
            ModalDialog(nil, ItemHit);

            case ItemHit of
                1: { OK button hit -- save resources }
                    begin
                        getDItem(theDialog, 3, itemType, itemHandle, dispRect);
                        GetIText(Handle(itemHandle), NextLaunch);
                        RmveResource(GetResource('STR ', 500));
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(NextLaunch)), 'STR ', 500, 'Next Launch');

                        RmveResource(GetResource('STR ', 502));
                        UpdateResFile(CurrentResFile);
                        AddResource(Handle(NewString(Defaults)), 'STR ', 502, 'Defaults')
                    end;

                2:
                    ; { Cancel button hit—do nothing    }


                4:
                    if ButtonSelected(theDialog, 4) then
                        begin { Look Up Next Launch button        }
                            where.h := 60;
                            where.v := 80;
                            whatToFind[0] := 'APPL';
                            ParamText('default application to launch', '', '', '');
                            SFGETFile(where, '', nil, 1, whatToFind, nil, fileReply);
                            if fileReply.good then
                                begin
                                    getDItem(theDialog, 3, itemType, itemHandle, dispRect);
                                    SetIText(Handle(itemHandle), fileReply.fName)
                                end;
                            FrameDItem(theDialog, Ok)
                        end;

                5:
                    begin
                        DoLocPriv := not DoLocPriv;
                        getDItem(theDialog, 5, itemType, itemHandle, dispRect);
                        thisButton := ControlHandle(itemHandle);
                        if DoLocPriv then
                            begin
                                SetCtlValue(thisButton, 1);
                                Defaults[1] := 'Y'
                            end
                        else
                            begin
                                SetCtlValue(thisButton, 0);
                                Defaults[1] := 'N'
                            end
                    end;

                6:
                    begin
                        DoNetPriv := not DoNetPriv;
                        getDItem(theDialog, 6, itemType, itemHandle, dispRect);
                        thisButton := ControlHandle(itemHandle);
                        if DoNetPriv then
                            begin
                                SetCtlValue(thisButton, 1);
                                Defaults[2] := 'Y'
                            end
                        else
                            begin
                                SetCtlValue(thisButton, 0);
                                Defaults[2] := 'N'
                            end
                    end;

                otherwise
                    ;    {    do nothing    }

            end;
        until (ItemHit = OK) or (ItemHit = 2);
        DisposDialog(theDialog)
    end;

{ ------------------------------------------------------ }

begin
    Initialize;
    if Button then
        HandleConfig
    else
        begin
            ShowMainDialog;
            HelloTabby;
            ReadSettings;
            ReadConfig;
            ReadMESSAGES;
            ProcessHeaders;
            CleanUp;
            if NextLaunch <> '' then
                LaunchNextAppl
        end
end.